home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / 491 / navel / viewManager.self < prev   
Encoding:
Text File  |  1993-07-18  |  12.6 KB  |  483 lines
  1. "viewManager.self,v 1.12 1993/07/18 20:24:10 richards Exp"
  2. "viewManager - self internal analogue of a display"
  3.  
  4. traits     _AddSlotsIfAbsent: (| ^ views* = () |)
  5. prototypes _AddSlotsIfAbsent: (| ^ views* = () |)
  6. mixins     _AddSlotsIfAbsent: (| ^ views* = () |)
  7. oddballs   _AddSlotsIfAbsent: (| ^ views* = () |)
  8.  
  9. traits views _AddSlotsIfAbsent: (| ^ viewManager = () |)
  10.  
  11. "remove this later!"
  12. traits views viewManager _Mirror size > 0 ifTrue: [viewManager shutdown]
  13.  
  14. traits views viewManager _Define: (|
  15.     
  16.     parent*** = traits clonable.    
  17.     comparisons** = mixins identity.
  18.     
  19.     copying* = (|
  20.     
  21.     "this will give us a dead display proxy"
  22.     ^ copy = (((((resend.copy display: display copy)
  23.                   eye: eye copy)
  24.               eventProcess: eventProcess copy)
  25.               managedViews: managedViews copyRemoveAll)
  26.           releasedViews: releasedViews copyRemoveAll).
  27.     |).
  28.     
  29.     lifeAndDeath* = (|
  30.     
  31.     ^ open = (open: '').
  32.     ^ open: name = (open: name IfFail: [^error: 'ViewManager open']).
  33.     ^ open: name IfFail: block = (copy initialise: name IfFail: block).
  34.     
  35.     _ howManyAttempts = 25.
  36.     
  37.     "this will need to be reworked if anything else can fail"
  38.     _ initialise: name IfFail: block = (|attempts|
  39.         howManyAttempts do: [
  40.         display: display open: name IfFail: [display].
  41.         display isLive ifTrue: [completeInit. ^self]
  42.               warning: 'retrying open display'].
  43.         block value).
  44.     
  45.     "this finishes the initialisation once this display is open"
  46.     _ completeInit = (
  47.         initColours.
  48.         initBitmaps.
  49.         spawnInputProcess.
  50.         managerList addLast: self.
  51.         warning: 'gc is a kludge'.
  52.         initFonts.
  53.         gc: xlib graphicsContext 
  54.           createForSameScreenAs: rootWindow.    
  55.         gc foreground: display screen blackPixel.
  56.         gc font: fixedFont fid.
  57.         gcb: xlib graphicsContext 
  58.           createForSameScreenAs: rootWindow.    
  59.         gcb foreground: display screen whitePixel.
  60.         gcb font: fixedFont fid.
  61.         initGCs.
  62.     ).
  63.     
  64.     
  65.     ^ close = (managerList remove: self.
  66.         stopInputProcess.
  67.         display close).
  68.     
  69.     ^ flush = (display flush).
  70.     ^ isOpen = (display isLive).
  71.     ^ isRunning = (eventProcess active).
  72.     
  73.     "some operations also run down the managerList"
  74.     
  75.     _ managerList = list copy.
  76.     
  77.     ^ someManager = 
  78.           (managerList isEmpty ifTrue: [open]. managerList first). 
  79.     
  80.     ^ shutdown = (managerList do: [|:m| m close]).
  81.     ^ closeAll = (managerList do: [|:m| m close]).
  82.     ^ flushAll = (managerList do: [|:m| m flush]).
  83.     
  84.     |).
  85.     
  86.     
  87.     inputProcessHandling* = (|
  88.     
  89.     "start up the event watcher process"
  90.     "this process runs asynchronously, gets events, and sends us 
  91.      to handle. Currently, each event is run synchronously"
  92.     spawnInputProcess = 
  93.           (eye: eventWatcher copyForDisplay: display SendingTo: self.
  94.         eventProcess: process copySend:
  95.           message copy receiver: eye Selector: 'watch'.
  96.         eventProcess resume).
  97.     
  98.     stopInputProcess = (eventProcess abort).
  99.     
  100.     restart = (nukeOldProc. spawnInputProcess).
  101.     
  102.     _ nukeOldProc = (eventProcess _StackDepthIfFail: [^ 42].
  103.         stopInputProcess).
  104.     
  105.     |).
  106.     
  107.     _ viewManagement* = (|
  108.     
  109.     "other window proxies may = this view, but they won't == it"
  110.     "this happens when an event returns a window, for example"
  111.     "this dictionary is used to canonicalise a window proxy"
  112.     "turning it into the view managed by this display"
  113.     
  114.     "manage adds a view into the eveny handling list"
  115.     "release removes it, and adds it to a 'releasedViews'"
  116.     "list. This happens with the view is unrealised - there may"
  117.     "still be events outstanding (notably destroyNotify)"
  118.     
  119.     "because of strangnesses with window proxies, we actually"
  120.     "index this by the window's X id"
  121.     
  122.     manage: view For: window = (managedViews at: window id Put: view).
  123.     
  124.     find: window = (
  125.         managedViews at: window id IfAbsent: [
  126.         (releasedViews includes: window id)
  127.               ifFalse: [warning: 'I can\'t find a window'].
  128.         eventMixin]).
  129.     
  130.     release: view For: window = (
  131.         ((managedViews at: window id IfAbsent: nil) == nil)
  132.           ifTrue: [ warning: 'bug *somewhere*' ].
  133.         managedViews remove: view 
  134.           IfAbsent: [warning: 'I can\'t find a window, again'].
  135.         releasedViews add: window id.
  136.         window kill. "Belt and braces"
  137.         self).
  138.     
  139.     "at some point we must kill off the proxy"
  140.     "this happens when the window comes of the releasedViews"
  141.     "list, when the destroyNotify comes in"        
  142.     
  143.     |).
  144.     
  145.     _ eventHandling* = (|
  146.     
  147.     keyPress: event = (
  148.         debugMessage: 'keyPress event'.
  149.         (find: event window) keyPress: event.
  150.         event delete.
  151.         self. ).
  152.     
  153.     keyRelease: event = (
  154.         debugMessage: 'keyRelease event'.
  155.         (find: event window) keyRelease: event.
  156.         event delete.
  157.         self).
  158.     
  159.     buttonPress: event = (
  160.         debugMessage: 'buttonPress event'.
  161.         (find: event window) buttonPress: event.
  162.         event delete.
  163.         self).
  164.     
  165.     buttonRelease: event = (
  166.         debugMessage: 'buttonRelease event'.
  167.         (find: event window) buttonRelease: event.
  168.         event delete.
  169.         self).
  170.     
  171.     motionNotify: event = (
  172.         debugMessage: 'motionNotify event'.
  173.         (find: event window) motionNotify: event.
  174.         event delete.
  175.         self).
  176.     
  177.     enterNotify: event = (
  178.         debugMessage: 'enterNotify event'.    
  179.         (find: event window) enterNotify: event.
  180.         event delete.
  181.         self).
  182.     
  183.     leaveNotify: event = (
  184.         debugMessage: 'leaveNotify event'.
  185.         (find: event window) leaveNotify: event.
  186.         event delete.
  187.         self).
  188.     
  189.     "focus in, out missing"
  190.         "keymap notify missing"
  191.     
  192.     expose: event = (
  193.         debugMessage: 'expose event'.
  194.         (event count = 0) ifTrue:
  195.           [(find: event window) expose: event].
  196.         event delete.
  197.         self).
  198.     
  199.     "graphicsExpose missing"
  200.     
  201.     noexpose: event = (
  202.         debugMessage: 'noexpose event'.
  203.         "            (find: event window) noexpose: event."
  204.         event delete.
  205.         self).
  206.     
  207.     
  208.     visibilityNotify: event = (
  209.         debugMessage: 'visibilityNotify event'.
  210.         event delete.
  211.         self).
  212.     
  213.     "createNotify/destroyNotify missing"
  214.     
  215.     unmapNotify: event = (
  216.         debugMessage: 'unmapNotify event'.
  217.         (find: event window) unmapNotify: event.
  218.         event delete.
  219.         self).
  220.     
  221.     mapNotify: event = (
  222.         debugMessage: 'mapNotify event'.
  223.         (find: event window) mapNotify: event.
  224.         event delete.
  225.         self).
  226.     
  227.     "mapRequest missing"
  228.     
  229.     reparentNotify: event = (
  230.         debugMessage: 'reparentNotify event'.
  231.         event delete.
  232.         self).
  233.     
  234.     configureNotify: event = (
  235.         debugMessage: 'configureNotify event'.
  236.         (find: event window) configureNotify: event.
  237.         event delete.
  238.         self).
  239.     
  240.     "configureRequest missing"
  241.     "gravityNotify missing"
  242.     "resizeRequest, circulateNotify, circulateRequest"
  243.     "propertyNotify"
  244.     "SelectionClear/Request/Notify"
  245.     "ColourmapNotify, MappingNotify missing"
  246.     
  247.     clientMessage: event = (
  248.         debugMessage: 'clientMessage event'.
  249.         (event message_type  = xlib wmProtocols) &&
  250.           [(event atomAt: 0) = xlib wmDeleteWindow]
  251.           ifTrue: [ debugMessage: 'wmDeleteWindow' ]
  252.           False: [ debugMessage: 'unknown clientMessage event' ].
  253.         event delete.
  254.         self).
  255.     
  256.     otherEvent: event = (
  257.         "debugMessage: 'unknown event: ', event type printString."
  258.         event delete.
  259.         self).
  260.     |).
  261.     
  262.     ^ eventMixin = (|
  263.     configureNotify: event = (42).
  264.     mapNotify: event = (42).
  265.     unmapNotify: event = (42).
  266.     expose: event = (42).
  267.     keyPress: event = (42).
  268.     keyRelease: event = (42).
  269.     buttonPress: event = (42).
  270.     buttonRelease: event = (42).
  271.     motionNotify: event = (42).
  272.     enterNotify: event = (42).
  273.     leaveNotify: event = (42).
  274.     visibilityNotify  = (42).
  275.     |).
  276.     
  277.     _ colourManagement* = (|
  278.     
  279.     "ultimately, this should handle real colourmaps"
  280.     "and call lookup colour rather than this :-)"
  281.     
  282.     _ initColours = (
  283.         pixelColours: pixelColours copyRemoveAll.
  284.         pixelColours at: 'white' Put: display screen whitePixel.
  285.         pixelColours at: 'black' Put: display screen blackPixel).
  286.     
  287.     ^ pixel: colour = (
  288.         pixelColours at: colour IfAbsent: [display screen blackPixel]).
  289.     
  290.     |).
  291.  
  292.     _ fontManagement* = (|
  293.     initFonts = (
  294.         fontCache: fontCache copyRemoveAll.
  295.         fixedFont: display loadFont: 'fixed'.
  296.         fontCache at: 'fixed' Put: fixedFont.  " prime the cache "
  297.     ).
  298.  
  299.     basicOpenFontNamed: fname = (| fid. |
  300.         fid: display loadFont: fname IfFail: [ 
  301.         warning: ('font ',fname,' not fount. Using fixed.').
  302.         fixedFont
  303.         ].
  304.         ^fid
  305.     ).
  306.  
  307.     openFontNamed: fname = (| fid. |
  308.         fid: fontCache at: fname IfAbsent: [
  309.         debugMessage: 'opening font: ',fname.
  310.         fid: basicOpenFontNamed: fname.
  311.         fontCache at: fname Put: fid.
  312.         fid
  313.         ].
  314.         ^fid
  315.     ).
  316.     |).
  317.  
  318.     _ gcManagement* = (|
  319.     initGCs = (| fixedFontGC. |
  320.         gcCache: gcCache copyRemoveAll.
  321.         fixedFontGC: allocateGcStruct.
  322.         fixedFontGC fontId: fixedFont fid.
  323.         fixedFontGC realiseGC.
  324.         gcCache addFirst: fixedFontGC.
  325.         gc: fixedFontGC gc.
  326.     ).
  327.  
  328.     allocateGcStruct = ( | newGC. |
  329.         (gcCache size > maxGCs) ifTrue: [
  330.         newGC: gcCache removeLast.
  331.         ] False: [
  332.         newGC: gcCacheStruct copy.
  333.         newGC gc: xlib graphicsContext createForSameScreenAs: rootWindow.
  334.         ].
  335.         newGC fontId: gc font.
  336.         newGC lineWidth: gc lineWidth.
  337.         newGC copyFunction: gc function.
  338.         newGC whitePixel: gc foreground.
  339.         newGC blackPixel: gc background.
  340.         newGC
  341.     ).
  342.  
  343.     gcWithCharacteristics: testBlock MakeIt: creationBlock = (| newGC. |
  344.         gcCache reverseDo: [ | :aGc |
  345.         (testBlock value: aGc) ifTrue: [
  346.             " found the right gc "
  347.             gcCache remove: aGc.    "remove... "
  348.             gcCache addFirst: aGc.  " and move to front"
  349.             ^aGc gc         
  350.         ].
  351.         ].
  352.         " didn't find what we needed. "
  353.         newGC: allocateGcStruct.
  354.         creationBlock value: newGC.
  355.  
  356.         "XXX - this could all be done in a single X protocol call "
  357.         newGC realiseGC.
  358.         debugMessage: ('allocated a new GC: ', newGC printString).
  359.  
  360.         gcCache addFirst: newGC.
  361.         newGC gc
  362.     ).
  363.     gcForFont: fid = (
  364.         gcWithCharacteristics: [ | :aGc | (aGc fontId = fid) ]
  365.           MakeIt: [ | :aGc | aGc fontId: fid. ].
  366.     ).
  367.     gcWidth: width = (
  368.         gcWithCharacteristics: [ | :aGc | (aGc lineWidth = width) ]
  369.           MakeIt: [ | :aGc | aGc lineWidth: width ].
  370.     ).
  371.     gcFunction: fct = (
  372.         gcWithCharacteristics: [ | :aGc | (aGc copyFunction = fct) ]
  373.           MakeIt: [ | :aGc | aGc copyFunction: fct ].
  374.     ).
  375.     |).
  376.         
  377.     
  378.     _ bitmaps* = (|
  379.     
  380.     "Perhaps some of this should be moved into the iconSelector, or
  381.      elsewhere. This would let us cache bitmapMakers (raw data) as well as
  382.      pixmaps. "
  383.     
  384.     ^ iconPath <- ''.
  385.     _ defaultIcon = ''.
  386.     
  387.     
  388.     _ defaultIconPathName <- '/usr/include/X11/bitmaps/escherknot'.
  389.     
  390.     ^ maxDepth <- 8.
  391.     
  392.     _ initBitmaps = (
  393.         (iconPath = '') ifTrue: [
  394.         iconPath: (unix environmentVariable: 'AATREE'       " XXX - This just doesn't belong here "
  395.               IfFail: [warning:  'Icon path not set'.'']) ,
  396.               '/bitmaps' ].
  397.         (defaultIconPathName = '') ifTrue: [
  398.         defaultIconPathName: 
  399.               unixFile locate: defaultIcon,'.icon' InPath: iconPath 
  400.               IfFail: [error: 'defaultIcon not found'. ]].
  401.         bitmapCache: bitmapCache copyRemoveAll.
  402.     ).
  403.     
  404.     "_" findBitmap: name Window: win = (
  405.         bitmapCache at: name IfAbsent: [|bitmap|
  406.         bitmap: ((xBitmapMaker copy 
  407.                   parseBitmapFile: locateIcon: name)
  408.               createBitmapForSameScreenAs: win).
  409.         bitmapCache at: name Put: bitmap.
  410.         bitmap]
  411.     ).
  412.         
  413.     ^ locateIcon: name = (
  414.         locateIcon: name IfFail: [
  415.         warning: 'Icon ',name, ' not found'. 
  416.         defaultIconPathName]
  417.     ).
  418.         
  419.     ^ locateIcon: name IfFail: block = (
  420.         unixFile locate: name,'.icon' InPath: iconPath IfFail: block).
  421.         
  422.     ^ iconExists: name = (locateIcon: name IfFail: [^false]. true).
  423.         
  424.     ^ flushBitmapCache = (bitmapCache removeAll).
  425.         
  426.     |).
  427.     
  428.     _ debugging* = (|
  429.     ^ debug <- false.
  430.     ^ debugMessage: str = ( debug ifTrue: [ str printLine ] ).
  431.     |).
  432.     
  433.     
  434.     printString = ('viewManager for ', display name).
  435.     
  436.     rootWindow = (display screen rootWindow display: display).
  437.     
  438.     ^ test = ( | barf. foo. bar. |
  439.     barf: viewManager open.
  440.     foo: compoundView copy name: 'foo'.
  441.     foo addSubView: (view copy iArea: (10@10)##(280@@20)).
  442.     foo addSubView: (view copy iArea: (10@40)##(280@@20)).
  443.     foo addSubView: (view copy iArea: (10@70)##(280@@20)).
  444.     foo realise map.
  445.     bar: foo copy.
  446.     bar realise map.
  447.     foo flush
  448.     ).
  449. |)
  450.       
  451. prototypes views _AddSlotsIfAbsent: (| ^ viewManager = () |)
  452. prototypes views viewManager _Define: (|
  453.     
  454.     parent* = traits views viewManager.
  455.     
  456.     _ thisObjectPrints = true.
  457.     
  458.     ^ display <- xlib display.
  459.     
  460.     _ eye. "eventWatcher"
  461.     "_" eventProcess <- process. "process the eventWatcher runs in"
  462.     
  463.     ^ managedViews <- dictionary.
  464.     ^ releasedViews <- list.
  465.     
  466.     gc <- xlib graphicsContext. "until defaultGCOfScreen goes!"
  467.     gcb <- xlib graphicsContext. "until defaultGCOfScreen goes!"
  468.     
  469.     _ pixelColours <- dictionary.
  470.     
  471.     _ bitmapCache <- dictionary.
  472.  
  473.     " Font Management "
  474.     _ fontCache <- dictionary.
  475.     _ fixedFont.
  476.  
  477.     " GC Cache "
  478.     _ gcCache <- list.
  479.     _ fixedFontGC.
  480.     _ maxGCs <- 16.
  481. |)
  482.       
  483.